home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / GRAPHICS.SWG / 0149_Fast Snow Flakes.pas < prev    next >
Pascal/Delphi Source File  |  1995-03-03  |  4KB  |  94 lines
  1. {
  2. {you've seen it before, but not this fast... :-) }
  3. (********************************************************************
  4.  Originally idea  : Nick Batalas, ( dated    14-6-1994 )
  5.  Sourced from                   : Eric Coolman, ( modified 19-6-1994 )
  6.  Rewritten by                   : Wil Barath,              03-9-1994
  7.  new : assembly optimisation, random weaving, memory reduction, etc.
  8.  ********************************************************************)
  9. {$G+}
  10. Program SnowFall;
  11. const
  12.   Flakes = 3000;     { higher = more flakes }
  13.   Fastest= 240;      { try smaller numbers for slower flakes}
  14.   Explosion = False; { False for no explosion }
  15. Var r:Word;
  16. {---------------- Stuff not specific to snowfall ----------------}
  17. Procedure vidMode(mode : byte);assembler;
  18.   asm mov ah,$00;  mov al,mode; int 10h; end;
  19. Function ReadKey:Char;Assembler;
  20. asm Mov ax,0000h; int 16h; end;
  21. Function Keypressed:Boolean;Assembler;
  22. asm Mov ax,0100h; int 16h; JNZ @1; Xor ax,ax; Ret;
  23. @1: Inc ax; end;
  24. Procedure Perturb;assembler;  {Peturbation algorhythm (C) 1982 BarathSoft}
  25. asm Mov dx,r; Xor dx,0aa55h; SHL dx,1; Adc dx,$118; Mov r,dx; end;
  26. {---------------------------MAIN PROGRAM-------------------------}
  27. Type FlakeyRec = Record x,y:Byte;p:Word; end;
  28. var  CurFlake,s,pf:Word;
  29.                  Flake:Array[0..flakes] of flakeyrec;
  30. Procedure Pascal_Version;
  31. Begin
  32.   repeat
  33.     for CurFlake:= 1 to flakes do with flake[curflake] do
  34.     begin
  35.       Perturb; Mem[$a000:p]:=0;
  36.       If x>=lo(r) then Inc(p);
  37.       If y>=Hi(r) then Inc(p,320);
  38.       Mem[$a000:p]:=y SHR 5 + $18;
  39.     end;
  40.     Repeat Until (port[$3da] and $08) = $08;  {wait for vRetrace }
  41.   until keypressed;
  42. end;
  43. Procedure Assembly_version;
  44. Begin
  45.   repeat              { * NOTE * the above pascal version was derived }
  46.        ASM            { from the assembly below, and is Very optimal. }
  47.           Mov dx,r
  48.           Mov cx,flakes             {for CurFlake:= 1 to flakes do}
  49.           Mov pf,Offset flake;      {with flake[curflake] do}
  50.           Mov ax,0a000h
  51.           Mov es,ax                 {begin}
  52.           Mov bx,$118
  53. @0:       Xor dx,0aa55h             {Perturb }
  54.           SHL dx,1
  55.           Adc dx,bx
  56.           Mov si,pf
  57.           Mov di,[si.FlakeyRec.p]
  58.           Xor al,al
  59.           Mov es:[di],al            {Mem[$a000:p]:=0;}
  60.           Cmp dl,[si.FlakeyRec.x]   {If x>=Lo(r) then Inc(p);}
  61.           Jnc @1
  62.           Inc di
  63. @1:       Mov ah,[si.FlakeyRec.y]
  64.           Cmp dh,ah                 {If y>=Hi(r) then Inc(p,320);}
  65.           Jnc @2
  66.           Add di,320
  67. @2:       Mov Word Ptr [si.FlakeyRec.p],di
  68.           Shr ah,5                  {Mem[$a000:p]:=y SHR 5 + $18;}
  69.           add ah,bl
  70.           Mov es:[di],ah
  71.           Add pf,Type flakeyRec
  72.           Loop @0
  73.           Mov r,dx
  74.         end;                        {end;}
  75.     Repeat Until (port[$3da] and $08) = $08;  { wait for vRetrace }
  76.   until keypressed;
  77. End;
  78. Begin
  79.   for CurFlake:=0 to Flakes do With Flake[curflake] do
  80.   begin                              { set up snow lookup table }
  81.     Perturb; Inc(s,r);
  82.     y:=Hi(Hi(r)*fastest)+5;
  83.     x:=Hi(Lo(r)*y)+1;                {limit x movement}
  84.     If explosion = False then p:=s;
  85.   end;
  86.   vidMode($13);                      { 320x200x256 graphics mode }
  87.   Repeat
  88.     Pascal_version;
  89.     If ReadKey=#27 then Break;
  90.     Assembly_version;
  91.   Until ReadKey=#27;
  92.   vidMode($03);                      { return to 80x25 textmode }
  93. end.
  94.